home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / back_end / mipsemit.t < prev    next >
Encoding:
Text File  |  1990-04-12  |  6.5 KB  |  190 lines
  1. (herald m68emit)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26.               
  27. (define (generate-move ref1 ref2)
  28.   (if (neq? ref1 ref2)
  29.       (cond ((and (pair? ref1) (null? (cdr ref1)))
  30.          (generate-move-address (car ref1) ref2))
  31.         ((register? ref2)
  32.          (cond ((register? ref1)
  33.             (emit risc/add ref1 zero ref2))
  34.            ((and (pair? ref1)
  35.              (eq? (car ref1) 'lit))
  36.             (move-small-number (cdr ref1) ref2))
  37.            (else
  38.             (emit risc/load 'l ref1 ref2))))
  39.         ((register? ref1)
  40.          (emit risc/store 'l ref1 ref2))
  41.         (else
  42.          (if (and (pair? ref1) (eq? (car ref1) 'lit))
  43.          (move-small-number (cdr ref1) extra)
  44.          (emit risc/load 'l ref1 extra))
  45.          (emit risc/store 'l extra ref2)))))
  46.  
  47. (define (generate-move-addressable x mreg)
  48.   (if (eq? x 0) (generate-move zero mreg)
  49.   (let ((reg (if (register? mreg) mreg extra)))
  50.   (xcond ((eq? x '#t)
  51.       (emit risc/add (machine-true-value) zero reg))
  52.          ((eq? x '#f)
  53.       (emit risc/add nil-reg zero reg))
  54.          ((representable-fixnum? x 'move)
  55.       (move-small-number (fx* x 4) reg))
  56.      ((fixnum? x)
  57.      (emit mips/lui (unsigned-num
  58.              (fixnum-logand #xffff (fixnum-ashr x 14))) reg)
  59.      (emit risc/or
  60.            (unsigned-num (fixnum-logand #xffff (fixnum-ashl x 2)))
  61.            reg reg))
  62.     ((char? x)
  63.      (emit risc/or (unsigned-num (fx+ (fixnum-ashl (char->ascii x) 8)
  64.                       header/char))
  65.                     zero reg)))
  66.   (generate-move reg mreg))))
  67.  
  68. (define (move-small-number x reg)
  69.   (if (fx> x 0)
  70.       (emit risc/or (unsigned-num x) zero reg)
  71.       (emit risc/add (machine-num x) zero reg)))
  72.  
  73. (define (emit-noop)
  74.   (emit mips/noop))
  75.  
  76.                                      
  77. (define (generate-move-address from to)
  78.   (cond ((register? to)
  79.          (if (or (atom? from)
  80.                  (neq? (car from) to)
  81.                  (neq? (cdr from) 0))
  82.              (emit risc/add (machine-num (cdr from)) (car from) to)))
  83.         (else
  84.      (emit risc/add (machine-num (cdr from)) (car from) extra)
  85.          (emit risc/store 'l extra to))))
  86.  
  87. (define (need-stack-frame)
  88.   (modify (lambda-max-temps *lambda*)
  89.       (lambda (max-temp)
  90.         (max 1 max-temp))))
  91.  
  92.  
  93. (define (emit-goto reg)
  94.   (need-stack-frame)
  95.   (emit-branch-and-link 8)        ;one past delay
  96.   (emit risc/add (machine-num template-return-offset) link-reg link-reg)
  97.   (emit risc/sll (machine-num 1) reg scratch)
  98.   (emit risc/add link-reg scratch scratch)
  99.   (emit mips/jr scratch)
  100.   (emit-noop))
  101.  
  102. (define (generate-move-pcrel from to)
  103.   (need-stack-frame)
  104.   (emit-branch-and-link 8) ;one past delay
  105.   (cond ((register? to)
  106.      (emit risc/add (tp-offset from) link-reg to))
  107.     (else
  108.      (emit risc/add (tp-offset from) link-reg extra)
  109.      (emit risc/store 'l extra to))))
  110.                
  111. (define-integrable (generate-slink-call offset)
  112.   (need-stack-frame)
  113.   (emit risc/load 'l (reg-offset nil-reg offset) extra)
  114.   (emit mips/jalr extra link-reg)
  115.   (emit risc/add (machine-num 12) link-reg link-reg)
  116.   (emit-bogus-stack-template))
  117.  
  118. (define-integrable (generate-slink-jump offset)
  119.   (emit risc/load 'l (reg-offset nil-reg offset) extra)
  120.   (emit mips/jr extra))
  121.  
  122. (define-integrable (generate-jump label)
  123.   (emit-jump label))
  124.  
  125. (define-integrable (generate-avoid-jump label)
  126.   (emit-avoid-jump label))
  127.  
  128. (define-integrable (generate-save-jump-and-link l)
  129.   (emit-branch-and-link l)
  130.   (emit risc/add (machine-num 12) link-reg link-reg)) ;skip template
  131.  
  132. (define-integrable (generate-save-avoid-jump-and-link l)
  133.   (emit-branch-and-link l)
  134.   (emit risc/add (machine-num 12) link-reg link-reg)) ;skip template
  135.  
  136.  
  137. (define (generate-general-call-and-link proc-var n-args)
  138.   (cond ((and (or (variable-binder proc-var)
  139.           (var-is-vcell? proc-var)))
  140.      (emit mips/load 'l (reg-offset nil-reg slink/icall) extra)
  141.      (generate-move (machine-num (fx+ n-args 1)) NARGS)
  142.      (emit mips/jalr extra link-reg))
  143.     (else
  144.          (emit mips/load 'l (reg-offset P (fx- tag/extend CELL)) extra)
  145.      (generate-move (machine-num (fx+ n-args 1)) NARGS)
  146.      (emit risc/add (machine-num 2) extra extra)
  147.          (emit mips/jalr extra link-reg)))
  148.   (emit risc/add (machine-num 12) link-reg link-reg)) ;skip template
  149.     
  150.  
  151. (define (generate-general-call proc-var n-args)
  152.   (cond ((and (or (variable-binder proc-var)
  153.           (var-is-vcell? proc-var)))
  154.      (emit risc/load 'l (reg-offset nil-reg slink/icall) extra)
  155.      (emit mips/jr extra)
  156.      (generate-move (machine-num (fx+ n-args 1)) NARGS))
  157.     (else
  158.          (emit risc/load 'l (reg-offset P (fx- tag/extend CELL)) extra)
  159.      (emit risc/add (machine-num 2) extra extra)
  160.      (emit mips/jr extra)
  161.          (generate-move (machine-num (fx+ n-args 1)) NARGS))))
  162.  
  163.  
  164. (define (generate-return n-args)               
  165.   (emit mips/jr link-reg)
  166.   (generate-move (machine-num (fx- -1 n-args)) NARGS))
  167.  
  168. (define (emit op . args)
  169.   (asemit op (map! ->field-group args)))
  170.  
  171.  
  172. (define (->field-group operand)
  173.   (xcond ((fixnum? operand)
  174.       (register->field-group operand))
  175.          ((atom? operand) operand)
  176.          ((fixnum? (car operand))
  177.       (list 'reg-offset (symbolic->machine-reg (car operand)) (cdr operand)))
  178.      ((atom? (car operand)) operand)))
  179.  
  180. (define (symbolic->machine-reg reg) reg)
  181.  
  182.  
  183. (define (register->field-group reg)
  184.   (cond ((fx< reg *real-registers*) (symbolic->machine-reg reg))
  185.     (else
  186.      (list 'reg-offset SP (fx* CELL (fx- reg *real-registers*))))))
  187.  
  188.  
  189.  
  190.